home *** CD-ROM | disk | FTP | other *** search
/ SGI Freeware 1999 August / SGI Freeware 1999 August.iso / dist / fw_xemacs.idb / usr / freeware / lib / xemacs-20.4 / lisp / gnus / nnweb.el.z / nnweb.el
Encoding:
Text File  |  1998-05-21  |  20.7 KB  |  694 lines
  1. ;;; nnweb.el --- retrieving articles via web search engines
  2. ;; Copyright (C) 1996,97 Free Software Foundation, Inc.
  3.  
  4. ;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
  5. ;; Keywords: news
  6.  
  7. ;; This file is part of GNU Emacs.
  8.  
  9. ;; GNU Emacs is free software; you can redistribute it and/or modify
  10. ;; it under the terms of the GNU General Public License as published by
  11. ;; the Free Software Foundation; either version 2, or (at your option)
  12. ;; any later version.
  13.  
  14. ;; GNU Emacs is distributed in the hope that it will be useful,
  15. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  16. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  17. ;; GNU General Public License for more details.
  18.  
  19. ;; You should have received a copy of the GNU General Public License
  20. ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  21. ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  22. ;; Boston, MA 02111-1307, USA.
  23.  
  24. ;;; Commentary:
  25.  
  26. ;; Note: You need to have `url' and `w3' installed for this
  27. ;; backend to work.
  28.  
  29. ;;; Code:
  30.  
  31. (eval-when-compile (require 'cl))
  32.  
  33. (require 'nnoo)
  34. (require 'message)
  35. (require 'gnus-util)
  36. (require 'gnus)
  37. (require 'w3)
  38. (require 'url)
  39. (require 'nnmail)
  40. (ignore-errors
  41.   (require 'w3-forms))
  42.  
  43. (nnoo-declare nnweb)
  44.  
  45. (defvoo nnweb-directory (nnheader-concat gnus-directory "nnweb/")
  46.   "Where nnweb will save its files.")
  47.  
  48. (defvoo nnweb-type 'dejanews
  49.   "What search engine type is being used.")
  50.  
  51. (defvar nnweb-type-definition
  52.   '((dejanews
  53.      (article . nnweb-dejanews-wash-article)
  54.      (map . nnweb-dejanews-create-mapping)
  55.      (search . nnweb-dejanews-search)
  56.      (address . "http://xp9.dejanews.com/dnquery.xp")
  57.      (identifier . nnweb-dejanews-identity))
  58.     (reference
  59.      (article . nnweb-reference-wash-article)
  60.      (map . nnweb-reference-create-mapping)
  61.      (search . nnweb-reference-search)
  62.      (address . "http://www.reference.com/cgi-bin/pn/go")
  63.      (identifier . identity))
  64.     (altavista
  65.      (article . nnweb-altavista-wash-article)
  66.      (map . nnweb-altavista-create-mapping)
  67.      (search . nnweb-altavista-search)
  68.      (address . "http://www.altavista.digital.com/cgi-bin/query")
  69.      (id . "/cgi-bin/news?id@%s")
  70.      (identifier . identity)))
  71.   "Type-definition alist.")
  72.  
  73. (defvoo nnweb-search nil
  74.   "Search string to feed to DejaNews.")
  75.  
  76. (defvoo nnweb-max-hits 100
  77.   "Maximum number of hits to display.")
  78.  
  79. (defvoo nnweb-ephemeral-p nil
  80.   "Whether this nnweb server is ephemeral.")
  81.  
  82. ;;; Internal variables
  83.  
  84. (defvoo nnweb-articles nil)
  85. (defvoo nnweb-buffer nil)
  86. (defvoo nnweb-group-alist nil)
  87. (defvoo nnweb-group nil)
  88. (defvoo nnweb-hashtb nil)
  89.  
  90. ;;; Interface functions
  91.  
  92. (nnoo-define-basics nnweb)
  93.  
  94. (deffoo nnweb-retrieve-headers (articles &optional group server fetch-old)
  95.   (nnweb-possibly-change-server group server)
  96.   (save-excursion
  97.     (set-buffer nntp-server-buffer)
  98.     (erase-buffer)
  99.     (let (article header)
  100.       (while (setq article (pop articles))
  101.     (when (setq header (cadr (assq article nnweb-articles)))
  102.       (nnheader-insert-nov header)))
  103.       'nov)))
  104.  
  105. (deffoo nnweb-request-scan (&optional group server)
  106.   (nnweb-possibly-change-server group server)
  107.   (setq nnweb-hashtb (gnus-make-hashtable 4095))
  108.   (funcall (nnweb-definition 'map))
  109.   (unless nnweb-ephemeral-p
  110.     (nnweb-write-active)
  111.     (nnweb-write-overview group)))
  112.  
  113. (deffoo nnweb-request-group (group &optional server dont-check)
  114.   (nnweb-possibly-change-server nil server)
  115.   (when (and group
  116.          (not (equal group nnweb-group))
  117.          (not nnweb-ephemeral-p))
  118.     (let ((info (assoc group nnweb-group-alist)))
  119.       (setq nnweb-group group)
  120.       (setq nnweb-type (nth 2 info))
  121.       (setq nnweb-search (nth 3 info))
  122.       (unless dont-check
  123.     (nnweb-read-overview group))))
  124.   (cond
  125.    ((not nnweb-articles)
  126.     (nnheader-report 'nnweb "No matching articles"))
  127.    (t
  128.     (let ((active (if nnweb-ephemeral-p
  129.               (cons (caar nnweb-articles)
  130.                 (caar (last nnweb-articles)))
  131.             (cadr (assoc group nnweb-group-alist)))))
  132.       (nnheader-report 'nnweb "Opened group %s" group)
  133.       (nnheader-insert
  134.        "211 %d %d %d %s\n" (length nnweb-articles)
  135.        (car active) (cdr active) group)))))
  136.  
  137. (deffoo nnweb-close-group (group &optional server)
  138.   (nnweb-possibly-change-server group server)
  139.   (when (gnus-buffer-live-p nnweb-buffer)
  140.     (save-excursion
  141.       (set-buffer nnweb-buffer)
  142.       (set-buffer-modified-p nil)
  143.       (kill-buffer nnweb-buffer)))
  144.   t)
  145.  
  146. (deffoo nnweb-request-article (article &optional group server buffer)
  147.   (nnweb-possibly-change-server group server)
  148.   (save-excursion
  149.     (set-buffer (or buffer nntp-server-buffer))
  150.     (let* ((header (cadr (assq article nnweb-articles)))
  151.        (url (and header (mail-header-xref header))))
  152.       (when (or (and url
  153.              (nnweb-fetch-url url))
  154.         (and (stringp article)
  155.              (nnweb-definition 'id t)
  156.              (let ((fetch (nnweb-definition 'id))
  157.                art)
  158.                (when (string-match "^<\\(.*\\)>$" article)
  159.              (setq art (match-string 1 article)))
  160.                (and fetch
  161.                 art
  162.                 (nnweb-fetch-url
  163.                  (format fetch article))))))
  164.     (unless nnheader-callback-function
  165.       (funcall (nnweb-definition 'article))
  166.       (nnweb-decode-entities))
  167.     (nnheader-report 'nnweb "Fetched article %s" article)
  168.     t))))
  169.  
  170. (deffoo nnweb-close-server (&optional server)
  171.   (when (and (nnweb-server-opened server)
  172.          (gnus-buffer-live-p nnweb-buffer))
  173.     (save-excursion
  174.       (set-buffer nnweb-buffer)
  175.       (set-buffer-modified-p nil)
  176.       (kill-buffer nnweb-buffer)))
  177.   (nnoo-close-server 'nnweb server))
  178.  
  179. (deffoo nnweb-request-list (&optional server)
  180.   (nnweb-possibly-change-server nil server)
  181.   (save-excursion
  182.     (set-buffer nntp-server-buffer)
  183.     (nnmail-generate-active nnweb-group-alist)
  184.     t))
  185.  
  186. (deffoo nnweb-request-update-info (group info &optional server)
  187.   (nnweb-possibly-change-server group server)
  188.   ;;(setcar (cddr info) nil)
  189.   )
  190.  
  191. (deffoo nnweb-asynchronous-p ()
  192.   t)
  193.  
  194. (deffoo nnweb-request-create-group (group &optional server args)
  195.   (nnweb-possibly-change-server nil server)
  196.   (nnweb-request-delete-group group)
  197.   (push `(,group ,(cons 1 0) ,@args) nnweb-group-alist)
  198.   (nnweb-write-active)
  199.   t)
  200.  
  201. (deffoo nnweb-request-delete-group (group &optional force server)
  202.   (nnweb-possibly-change-server group server)
  203.   (gnus-delete-assoc group nnweb-group-alist)
  204.   (gnus-delete-file (nnweb-overview-file group))
  205.   t)
  206.  
  207. (nnoo-define-skeleton nnweb)
  208.  
  209. ;;; Internal functions
  210.  
  211. (defun nnweb-read-overview (group)
  212.   "Read the overview of GROUP and build the map."
  213.   (when (file-exists-p (nnweb-overview-file group))
  214.     (nnheader-temp-write nil
  215.       (nnheader-insert-file-contents (nnweb-overview-file group))
  216.       (goto-char (point-min))
  217.       (let (header)
  218.     (while (not (eobp))
  219.       (setq header (nnheader-parse-nov))
  220.       (forward-line 1)
  221.       (push (list (mail-header-number header)
  222.               header (mail-header-xref header))
  223.         nnweb-articles)
  224.       (nnweb-set-hashtb header (car nnweb-articles)))))))
  225.  
  226. (defun nnweb-write-overview (group)
  227.   "Write the overview file for GROUP."
  228.   (nnheader-temp-write (nnweb-overview-file group)
  229.     (let ((articles nnweb-articles))
  230.       (while articles
  231.     (nnheader-insert-nov (cadr (pop articles)))))))
  232.  
  233. (defun nnweb-set-hashtb (header data)
  234.   (gnus-sethash (nnweb-identifier (mail-header-xref header))
  235.         data nnweb-hashtb))
  236.  
  237. (defun nnweb-get-hashtb (url)
  238.   (gnus-gethash (nnweb-identifier url) nnweb-hashtb))
  239.  
  240. (defun nnweb-identifier (ident)
  241.   (funcall (nnweb-definition 'identifier) ident))
  242.  
  243. (defun nnweb-overview-file (group)
  244.   "Return the name of the overview file of GROUP."
  245.   (nnheader-concat nnweb-directory group ".overview"))
  246.  
  247. (defun nnweb-write-active ()
  248.   "Save the active file."
  249.   (nnheader-temp-write (nnheader-concat nnweb-directory "active")
  250.     (prin1 `(setq nnweb-group-alist ',nnweb-group-alist) (current-buffer))))
  251.  
  252. (defun nnweb-read-active ()
  253.   "Read the active file."
  254.   (load (nnheader-concat nnweb-directory "active") t t t))
  255.  
  256. (defun nnweb-definition (type &optional noerror)
  257.   "Return the definition of TYPE."
  258.   (let ((def (cdr (assq type (assq nnweb-type nnweb-type-definition)))))
  259.     (when (and (not def)
  260.            (not noerror))
  261.       (error "Undefined definition %s" type))
  262.     def))
  263.  
  264. (defun nnweb-possibly-change-server (&optional group server)
  265.   (nnweb-init server)
  266.   (when server
  267.     (unless (nnweb-server-opened server)
  268.       (nnweb-open-server server)))
  269.   (unless nnweb-group-alist
  270.     (nnweb-read-active))
  271.   (when group
  272.     (when (and (not nnweb-ephemeral-p)
  273.            (not (equal group nnweb-group)))
  274.       (nnweb-request-group group nil t))))
  275.  
  276. (defun nnweb-init (server)
  277.   "Initialize buffers and such."
  278.   (unless (gnus-buffer-live-p nnweb-buffer)
  279.     (setq nnweb-buffer
  280.       (save-excursion
  281.         (nnheader-set-temp-buffer
  282.          (format " *nnweb %s %s %s*" nnweb-type nnweb-search server))))))
  283.  
  284. (defun nnweb-fetch-url (url)
  285.   (save-excursion
  286.     (if (not nnheader-callback-function)
  287.     (let ((buf (current-buffer)))
  288.       (save-excursion
  289.         (set-buffer nnweb-buffer)
  290.         (erase-buffer)
  291.         (url-insert-file-contents url)
  292.         (copy-to-buffer buf (point-min) (point-max))
  293.         t))
  294.       (nnweb-url-retrieve-asynch
  295.        url 'nnweb-callback (current-buffer) nnheader-callback-function)
  296.       t)))
  297.  
  298. (defun nnweb-callback (buffer callback)
  299.   (when (gnus-buffer-live-p url-working-buffer)
  300.     (save-excursion
  301.       (set-buffer url-working-buffer)
  302.       (funcall (nnweb-definition 'article))
  303.       (nnweb-decode-entities)
  304.       (set-buffer buffer)
  305.       (goto-char (point-max))
  306.       (insert-buffer-substring url-working-buffer))
  307.     (funcall callback t)
  308.     (gnus-kill-buffer url-working-buffer)))
  309.  
  310. (defun nnweb-url-retrieve-asynch (url callback &rest data)
  311.   (let ((url-request-method "GET")
  312.     (old-asynch url-be-asynchronous)
  313.     (url-request-data nil)
  314.     (url-request-extra-headers nil)
  315.     (url-working-buffer (generate-new-buffer-name " *nnweb*")))
  316.     (setq-default url-be-asynchronous t)
  317.     (save-excursion
  318.       (set-buffer (get-buffer-create url-working-buffer))
  319.       (setq url-current-callback-data data
  320.         url-be-asynchronous t
  321.         url-current-callback-func callback)
  322.       (url-retrieve url))
  323.     (setq-default url-be-asynchronous old-asynch)))
  324.  
  325. (defun nnweb-encode-www-form-urlencoded (pairs)
  326.   "Return PAIRS encoded for forms."
  327.   (mapconcat
  328.    (function
  329.     (lambda (data)
  330.       (concat (w3-form-encode-xwfu (car data)) "="
  331.           (w3-form-encode-xwfu (cdr data)))))
  332.    pairs "&"))
  333.  
  334. (defun nnweb-fetch-form (url pairs)
  335.   (let ((url-request-data (nnweb-encode-www-form-urlencoded pairs))
  336.     (url-request-method "POST")
  337.     (url-request-extra-headers
  338.      '(("Content-type" . "application/x-www-form-urlencoded"))))
  339.     (url-insert-file-contents url)
  340.     (setq buffer-file-name nil))
  341.   t)
  342.  
  343. (defun nnweb-decode-entities ()
  344.   (goto-char (point-min))
  345.   (while (re-search-forward "&\\([a-z]+\\);" nil t)
  346.     (replace-match (char-to-string (or (cdr (assq (intern (match-string 1))
  347.                           w3-html-entities))
  348.                        ?#))
  349.            t t)))
  350.  
  351. (defun nnweb-remove-markup ()
  352.   (goto-char (point-min))
  353.   (while (search-forward "<!--" nil t)
  354.     (delete-region (match-beginning 0)
  355.            (or (search-forward "-->" nil t)
  356.                (point-max))))
  357.   (goto-char (point-min))
  358.   (while (re-search-forward "<[^>]+>" nil t)
  359.     (replace-match "" t t)))
  360.  
  361. ;;;
  362. ;;; DejaNews functions.
  363. ;;;
  364.  
  365. (defun nnweb-dejanews-create-mapping ()
  366.   "Perform the search and create an number-to-url alist."
  367.   (save-excursion
  368.     (set-buffer nnweb-buffer)
  369.     (erase-buffer)
  370.     (when (funcall (nnweb-definition 'search) nnweb-search)
  371.       (let ((i 0)
  372.         (more t)
  373.         (case-fold-search t)
  374.         (active (or (cadr (assoc nnweb-group nnweb-group-alist))
  375.             (cons 1 0)))
  376.         Subject Score Date Newsgroup Author
  377.         map url)
  378.     (while more
  379.       ;; Go through all the article hits on this page.
  380.       (goto-char (point-min))
  381.       (nnweb-decode-entities)
  382.       (goto-char (point-min))
  383.       (while (re-search-forward "^ +[0-9]+\\." nil t)
  384.         (narrow-to-region
  385.          (point)
  386.          (cond ((re-search-forward "^ +[0-9]+\\." nil t)
  387.             (match-beginning 0))
  388.            ((search-forward "\n\n" nil t)
  389.             (point))
  390.            (t
  391.             (point-max))))
  392.         (goto-char (point-min))
  393.         (when (looking-at ".*HREF=\"\\([^\"]+\\)\"")
  394.           (setq url (match-string 1)))
  395.         (nnweb-remove-markup)
  396.         (goto-char (point-min))
  397.         (while (search-forward "\t" nil t)
  398.           (replace-match " "))
  399.         (goto-char (point-min))
  400.         (while (re-search-forward "^ +\\([^:]+\\): +\\(.*\\)$" nil t)
  401.           (set (intern (match-string 1)) (match-string 2)))
  402.         (widen)
  403.         (when (string-match "#[0-9]+/[0-9]+ *$" Subject)
  404.           (setq Subject (substring Subject 0 (match-beginning 0))))
  405.         (incf i)
  406.         (unless (nnweb-get-hashtb url)
  407.           (push
  408.            (list
  409.         (incf (cdr active))
  410.         (make-full-mail-header
  411.          (cdr active) (concat  "(" Newsgroup ") " Subject) Author Date
  412.          (concat "<" (nnweb-identifier url) "@dejanews>")
  413.          nil 0 (string-to-int Score) url))
  414.            map)
  415.           (nnweb-set-hashtb (cadar map) (car map))))
  416.       ;; See whether there is a "Get next 20 hits" button here.
  417.       (if (or (not (re-search-forward
  418.             "HREF=\"\\([^\"]+\\)\">Get next" nil t))
  419.           (>= i nnweb-max-hits))
  420.           (setq more nil)
  421.         ;; Yup -- fetch it.
  422.         (setq more (match-string 1))
  423.         (erase-buffer)
  424.         (url-insert-file-contents more)))
  425.     ;; Return the articles in the right order.
  426.     (setq nnweb-articles
  427.           (sort (nconc nnweb-articles map)
  428.             (lambda (s1 s2) (< (car s1) (car s2)))))))))
  429.  
  430. (defun nnweb-dejanews-wash-article ()
  431.   (let ((case-fold-search t))
  432.     (goto-char (point-min))
  433.     (re-search-forward "<PRE>" nil t)
  434.     (delete-region (point-min) (point))
  435.     (re-search-forward "</PRE>" nil t)
  436.     (delete-region (point) (point-max))
  437.     (nnweb-remove-markup)
  438.     (goto-char (point-min))
  439.     (while (and (looking-at " *$")
  440.         (not (eobp)))
  441.       (gnus-delete-line))
  442.     (while (looking-at "\\(^[^ ]+:\\) *")
  443.       (replace-match "\\1 " t)
  444.       (forward-line 1))
  445.     (when (re-search-forward "\n\n+" nil t)
  446.       (replace-match "\n" t t))
  447.     (goto-char (point-min))
  448.     (when (search-forward "[More Headers]" nil t)
  449.       (replace-match "" t t))))
  450.  
  451. (defun nnweb-dejanews-search (search)
  452.   (nnweb-fetch-form
  453.    (nnweb-definition 'address)
  454.    `(("query" . ,search)
  455.      ("defaultOp" . "AND")
  456.      ("svcclass" . "dncurrent")
  457.      ("maxhits" . "100")
  458.      ("format" . "verbose")
  459.      ("threaded" . "0")
  460.      ("showsort" . "score")
  461.      ("agesign" . "1")
  462.      ("ageweight" . "1")))
  463.   t)
  464.  
  465. (defun nnweb-dejanews-identity (url)
  466.   "Return an unique identifier based on URL."
  467.   (if (string-match "recnum=\\([0-9]+\\)" url)
  468.       (match-string 1 url)
  469.     url))
  470.  
  471. ;;;
  472. ;;; InReference
  473. ;;;
  474.  
  475. (defun nnweb-reference-create-mapping ()
  476.   "Perform the search and create an number-to-url alist."
  477.   (save-excursion
  478.     (set-buffer nnweb-buffer)
  479.     (erase-buffer)
  480.     (when (funcall (nnweb-definition 'search) nnweb-search)
  481.       (let ((i 0)
  482.         (more t)
  483.         (case-fold-search t)
  484.         (active (or (cadr (assoc nnweb-group nnweb-group-alist))
  485.             (cons 1 0)))
  486.         Subject Score Date Newsgroups From Message-ID
  487.         map url)
  488.     (while more
  489.       ;; Go through all the article hits on this page.
  490.       (goto-char (point-min))
  491.       (search-forward "</pre><hr>" nil t)
  492.       (delete-region (point-min) (point))
  493.                     ;(nnweb-decode-entities)
  494.       (goto-char (point-min))
  495.       (while (re-search-forward "^ +[0-9]+\\." nil t)
  496.         (narrow-to-region
  497.          (point)
  498.          (if (re-search-forward "^$" nil t)
  499.          (match-beginning 0)
  500.            (point-max)))
  501.         (goto-char (point-min))
  502.         (when (looking-at ".*href=\"\\([^\"]+\\)\"")
  503.           (setq url (match-string 1)))
  504.         (nnweb-remove-markup)
  505.         (goto-char (point-min))
  506.         (while (search-forward "\t" nil t)
  507.           (replace-match " "))
  508.         (goto-char (point-min))
  509.         (while (re-search-forward "^\\([^:]+\\): \\(.*\\)$" nil t)
  510.           (set (intern (match-string 1)) (match-string 2)))
  511.         (widen)
  512.         (search-forward "</pre>" nil t)
  513.         (incf i)
  514.         (unless (nnweb-get-hashtb url)
  515.           (push
  516.            (list
  517.         (incf (cdr active))
  518.         (make-full-mail-header
  519.          (cdr active) (concat  "(" Newsgroups ") " Subject) From Date
  520.          Message-ID
  521.          nil 0 (string-to-int Score) url))
  522.            map)
  523.           (nnweb-set-hashtb (cadar map) (car map))))
  524.       (setq more nil))
  525.     ;; Return the articles in the right order.
  526.     (setq nnweb-articles
  527.           (sort (nconc nnweb-articles map)
  528.             (lambda (s1 s2) (< (car s1) (car s2)))))))))
  529.  
  530. (defun nnweb-reference-wash-article ()
  531.   (let ((case-fold-search t))
  532.     (goto-char (point-min))
  533.     (re-search-forward "^</center><hr>" nil t)
  534.     (delete-region (point-min) (point))
  535.     (search-forward "<pre>" nil t)
  536.     (forward-line -1)
  537.     (let ((body (point-marker)))
  538.       (search-forward "</pre>" nil t)
  539.       (delete-region (point) (point-max))
  540.       (nnweb-remove-markup)
  541.       (goto-char (point-min))
  542.       (while (looking-at " *$")
  543.     (gnus-delete-line))
  544.       (narrow-to-region (point-min) body)
  545.       (while (and (re-search-forward "^$" nil t)
  546.           (not (eobp)))
  547.     (gnus-delete-line))
  548.       (goto-char (point-min))
  549.       (while (looking-at "\\(^[^ ]+:\\) *")
  550.     (replace-match "\\1 " t)
  551.     (forward-line 1))
  552.       (goto-char (point-min))
  553.       (when (re-search-forward "^References:" nil t)
  554.     (narrow-to-region
  555.      (point) (if (re-search-forward "^$\\|^[^:]+:" nil t)
  556.              (match-beginning 0)
  557.            (point-max)))
  558.     (goto-char (point-min))
  559.     (while (not (eobp))
  560.       (unless (looking-at "References")
  561.         (insert "\t")
  562.         (forward-line 1)))
  563.     (goto-char (point-min))
  564.     (while (search-forward "," nil t)
  565.       (replace-match " " t t)))
  566.       (widen)
  567.       (set-marker body nil))))
  568.  
  569. (defun nnweb-reference-search (search)
  570.   (url-insert-file-contents
  571.    (concat
  572.     (nnweb-definition 'address)
  573.     "?"
  574.     (nnweb-encode-www-form-urlencoded
  575.      `(("search" . "advanced")
  576.        ("querytext" . ,search)
  577.        ("subj" . "")
  578.        ("name" . "")
  579.        ("login" . "")
  580.        ("host" . "")
  581.        ("organization" . "")
  582.        ("groups" . "")
  583.        ("keywords" . "")
  584.        ("choice" . "Search")
  585.        ("startmonth" . "Jul")
  586.        ("startday" . "25")
  587.        ("startyear" . "1996")
  588.        ("endmonth" . "Aug")
  589.        ("endday" . "24")
  590.        ("endyear" . "1996")
  591.        ("mode" . "Quick")
  592.        ("verbosity" . "Verbose")
  593.        ("ranking" . "Relevance")
  594.        ("first" . "1")
  595.        ("last" . "25")
  596.        ("score" . "50")))))
  597.   (setq buffer-file-name nil)
  598.   t)
  599.  
  600. ;;;
  601. ;;; Alta Vista
  602. ;;;
  603.  
  604. (defun nnweb-altavista-create-mapping ()
  605.   "Perform the search and create an number-to-url alist."
  606.   (save-excursion
  607.     (set-buffer nnweb-buffer)
  608.     (erase-buffer)
  609.     (let ((part 0))
  610.       (when (funcall (nnweb-definition 'search) nnweb-search part)
  611.     (let ((i 0)
  612.           (more t)
  613.           (case-fold-search t)
  614.           (active (or (cadr (assoc nnweb-group nnweb-group-alist))
  615.               (cons 1 0)))
  616.           subject date from id group
  617.           map url)
  618.       (while more
  619.         ;; Go through all the article hits on this page.
  620.         (goto-char (point-min))
  621.         (search-forward "<dt>" nil t)
  622.         (delete-region (point-min) (match-beginning 0))
  623.         (goto-char (point-min))
  624.         (while (search-forward "<dt>" nil t)
  625.           (replace-match "\n<blubb>"))
  626.         (nnweb-decode-entities)
  627.         (goto-char (point-min))
  628.         (while (re-search-forward "<blubb>.*href=\"\\([^\"]+\\)\"><strong>\\([^>]*\\)</strong></a><dd>\\([^-]+\\)- <b>\\([^<]+\\)<.*href=\"news:\\([^\"]+\\)\">.*\">\\(.+\\)</a><P>"
  629.                       nil t)
  630.           (setq url (match-string 1)
  631.             subject (match-string 2)
  632.             date (match-string 3)
  633.             group (match-string 4)
  634.             id (concat "<" (match-string 5) ">")
  635.             from (match-string 6))
  636.           (incf i)
  637.           (unless (nnweb-get-hashtb url)
  638.         (push
  639.          (list
  640.           (incf (cdr active))
  641.           (make-full-mail-header
  642.            (cdr active) (concat  "(" group ") " subject) from date
  643.            id nil 0 0 url))
  644.          map)
  645.         (nnweb-set-hashtb (cadar map) (car map))))
  646.         ;; See if we want more.
  647.         (when (or (not nnweb-articles)
  648.               (>= i nnweb-max-hits)
  649.               (not (funcall (nnweb-definition 'search)
  650.                     nnweb-search (incf part))))
  651.           (setq more nil)))
  652.       ;; Return the articles in the right order.
  653.       (setq nnweb-articles
  654.         (sort (nconc nnweb-articles map)
  655.               (lambda (s1 s2) (< (car s1) (car s2))))))))))
  656.  
  657. (defun nnweb-altavista-wash-article ()
  658.   (goto-char (point-min))
  659.   (let ((case-fold-search t))
  660.     (when (re-search-forward "^<strong>" nil t)
  661.       (delete-region (point-min) (match-beginning 0)))
  662.     (goto-char (point-min))
  663.     (while (looking-at "<strong>\\([^ ]+\\) +</strong> +\\(.*\\)$")
  664.       (replace-match "\\1: \\2" t)
  665.       (forward-line 1))
  666.     (when (re-search-backward "^References:" nil t)
  667.       (narrow-to-region (point) (progn (forward-line 1) (point)))
  668.       (goto-char (point-min))
  669.       (while (re-search-forward "<A.*\\?id@\\([^\"]+\\)\">[0-9]+</A>" nil t)
  670.     (replace-match "<\\1> " t)))
  671.     (widen)
  672.     (nnweb-remove-markup)))
  673.  
  674. (defun nnweb-altavista-search (search &optional part)
  675.   (url-insert-file-contents
  676.    (concat
  677.     (nnweb-definition 'address)
  678.     "?"
  679.     (nnweb-encode-www-form-urlencoded
  680.      `(("pg" . "aq")
  681.        ("what" . "news")
  682.        ,@(when part `(("stq" . ,(int-to-string (* part 30)))))
  683.        ("fmt" . "d")
  684.        ("q" . ,search)
  685.        ("r" . "")
  686.        ("d0" . "")
  687.        ("d1" . "")))))
  688.   (setq buffer-file-name nil)
  689.   t)
  690.  
  691. (provide 'nnweb)
  692.  
  693. ;;; nnweb.el ends here
  694.